You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by jf...@apache.org on 2011/10/18 16:35:26 UTC
svn commit: r1185688 [4/4] - in /thrift/trunk: ./ compiler/cpp/
compiler/cpp/src/ compiler/cpp/src/generate/ lib/delphi/ lib/delphi/src/
lib/delphi/test/ test/
Added: thrift/trunk/lib/delphi/src/Thrift.Transport.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/src/Thrift.Transport.pas?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/src/Thrift.Transport.pas (added)
+++ thrift/trunk/lib/delphi/src/Thrift.Transport.pas Tue Oct 18 14:35:26 2011
@@ -0,0 +1,1250 @@
+(*
+ * 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.
+ *)
+
+ {$SCOPEDENUMS ON}
+
+unit Thrift.Transport;
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ Sockets,
+ Generics.Collections,
+ Thrift.Collections,
+ Thrift.Utils,
+ Thrift.Stream,
+ ActiveX,
+ msxml;
+
+type
+ ITransport = interface
+ ['{A4A9FC37-D620-44DC-AD21-662D16364CE4}']
+ function GetIsOpen: Boolean;
+ property IsOpen: Boolean read GetIsOpen;
+ function Peek: Boolean;
+ procedure Open;
+ procedure Close;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer;
+ function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;
+ procedure Write( const buf: TBytes); overload;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); overload;
+ procedure Flush;
+ end;
+
+ TTransportImpl = class( TInterfacedObject, ITransport)
+ protected
+ function GetIsOpen: Boolean; virtual; abstract;
+ property IsOpen: Boolean read GetIsOpen;
+ function Peek: Boolean;
+ procedure Open(); virtual; abstract;
+ procedure Close(); virtual; abstract;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; abstract;
+ function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; virtual;
+ procedure Write( const buf: TBytes); overload; virtual;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; virtual; abstract;
+ procedure Flush; virtual;
+ end;
+
+ TTransportException = class( Exception )
+ public
+ type
+ TExceptionType = (
+ Unknown,
+ NotOpen,
+ AlreadyOpen,
+ TimedOut,
+ EndOfFile
+ );
+ private
+ FType : TExceptionType;
+ public
+ constructor Create( AType: TExceptionType); overload;
+ constructor Create( const msg: string); overload;
+ constructor Create( AType: TExceptionType; const msg: string); overload;
+ property Type_: TExceptionType read FType;
+ end;
+
+ IHTTPClient = interface( ITransport )
+ ['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}']
+ procedure SetConnectionTimeout(const Value: Integer);
+ function GetConnectionTimeout: Integer;
+ procedure SetReadTimeout(const Value: Integer);
+ function GetReadTimeout: Integer;
+ function GetCustomHeaders: IThriftDictionary<string,string>;
+ procedure SendRequest;
+ property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+ property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
+ property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
+ end;
+
+ THTTPClientImpl = class( TTransportImpl, IHTTPClient)
+ private
+ FUri : string;
+ FInputStream : IThriftStream;
+ FOutputStream : IThriftStream;
+ FConnectionTimeout : Integer;
+ FReadTimeout : Integer;
+ FCustomHeaders : IThriftDictionary<string,string>;
+
+ function CreateRequest: IXMLHTTPRequest;
+ protected
+ function GetIsOpen: Boolean; override;
+ procedure Open(); override;
+ procedure Close(); override;
+ function Read( var buf: TBytes; off: Integer; len: Integer): Integer; override;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ procedure Flush; override;
+
+ procedure SetConnectionTimeout(const Value: Integer);
+ function GetConnectionTimeout: Integer;
+ procedure SetReadTimeout(const Value: Integer);
+ function GetReadTimeout: Integer;
+ function GetCustomHeaders: IThriftDictionary<string,string>;
+ procedure SendRequest;
+ property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+ property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
+ property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
+ public
+ constructor Create( const AUri: string);
+ destructor Destroy; override;
+ end;
+
+ IServerTransport = interface
+ ['{BF6B7043-DA22-47BF-8B11-2B88EC55FE12}']
+ procedure Listen;
+ procedure Close;
+ function Accept: ITransport;
+ end;
+
+ TServerTransportImpl = class( TInterfacedObject, IServerTransport)
+ protected
+ function AcceptImpl: ITransport; virtual; abstract;
+ public
+ procedure Listen; virtual; abstract;
+ procedure Close; virtual; abstract;
+ function Accept: ITransport;
+ end;
+
+ ITransportFactory = interface
+ ['{DD809446-000F-49E1-9BFF-E0D0DC76A9D7}']
+ function GetTransport( ATrans: ITransport): ITransport;
+ end;
+
+ TTransportFactoryImpl = class( TInterfacedObject, ITransportFactory)
+ function GetTransport( ATrans: ITransport): ITransport; virtual;
+ end;
+
+ TTcpSocketStreamImpl = class( TThriftStreamImpl )
+ private
+ FTcpClient : TCustomIpClient;
+ protected
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( ATcpClient: TCustomIpClient);
+ end;
+
+ IStreamTransport = interface( ITransport )
+ ['{A8479B47-2A3E-4421-A9A0-D5A9EDCC634A}']
+ function GetInputStream: IThriftStream;
+ function GetOutputStream: IThriftStream;
+ property InputStream : IThriftStream read GetInputStream;
+ property OutputStream : IThriftStream read GetOutputStream;
+ end;
+
+ TStreamTransportImpl = class( TTransportImpl, IStreamTransport)
+ protected
+ FInputStream : IThriftStream;
+ FOutputStream : IThriftStream;
+ protected
+ function GetIsOpen: Boolean; override;
+
+ function GetInputStream: IThriftStream;
+ function GetOutputStream: IThriftStream;
+ public
+ property InputStream : IThriftStream read GetInputStream;
+ property OutputStream : IThriftStream read GetOutputStream;
+
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ constructor Create( AInputStream : IThriftStream; AOutputStream : IThriftStream);
+ destructor Destroy; override;
+ end;
+
+ TBufferedStreamImpl = class( TThriftStreamImpl)
+ private
+ FStream : IThriftStream;
+ FBufSize : Integer;
+ FBuffer : TMemoryStream;
+ protected
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( AStream: IThriftStream; ABufSize: Integer);
+ destructor Destroy; override;
+ end;
+
+ TServerSocketImpl = class( TServerTransportImpl)
+ private
+ FServer : TTcpServer;
+ FPort : Integer;
+ FClientTimeout : Integer;
+ FUseBufferedSocket : Boolean;
+ FOwnsServer : Boolean;
+ protected
+ function AcceptImpl: ITransport; override;
+ public
+ constructor Create( AServer: TTcpServer ); overload;
+ constructor Create( AServer: TTcpServer; AClientTimeout: Integer); overload;
+ constructor Create( APort: Integer); overload;
+ constructor Create( APort: Integer; AClientTimeout: Integer); overload;
+ constructor Create( APort: Integer; AClientTimeout: Integer;
+ AUseBufferedSockets: Boolean); overload;
+ destructor Destroy; override;
+ procedure Listen; override;
+ procedure Close; override;
+ end;
+
+ TBufferedTransportImpl = class( TTransportImpl )
+ private
+ FInputBuffer : IThriftStream;
+ FOutputBuffer : IThriftStream;
+ FTransport : IStreamTransport;
+ FBufSize : Integer;
+
+ procedure InitBuffers;
+ function GetUnderlyingTransport: ITransport;
+ protected
+ function GetIsOpen: Boolean; override;
+ procedure Flush; override;
+ public
+ procedure Open(); override;
+ procedure Close(); override;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ constructor Create( ATransport : IStreamTransport ); overload;
+ constructor Create( ATransport : IStreamTransport; ABufSize: Integer); overload;
+ property UnderlyingTransport: ITransport read GetUnderlyingTransport;
+ property IsOpen: Boolean read GetIsOpen;
+ end;
+
+ TSocketImpl = class(TStreamTransportImpl)
+ private
+ FClient : TCustomIpClient;
+ FOwnsClient : Boolean;
+ FHost : string;
+ FPort : Integer;
+ FTimeout : Integer;
+
+ procedure InitSocket;
+ protected
+ function GetIsOpen: Boolean; override;
+ public
+ procedure Open; override;
+ constructor Create( AClient : TCustomIpClient); overload;
+ constructor Create( const AHost: string; APort: Integer); overload;
+ constructor Create( const AHost: string; APort: Integer; ATimeout: Integer); overload;
+ destructor Destroy; override;
+ procedure Close; override;
+ property TcpClient: TCustomIpClient read FClient;
+ property Host : string read FHost;
+ property Port: Integer read FPort;
+ end;
+
+ TFramedTransportImpl = class( TTransportImpl)
+ private const
+ FHeaderSize : Integer = 4;
+ private class var
+ FHeader_Dummy : array of Byte;
+ protected
+ FTransport : ITransport;
+ FWriteBuffer : TMemoryStream;
+ FReadBuffer : TMemoryStream;
+
+ procedure InitWriteBuffer;
+ procedure ReadFrame;
+ public
+ type
+ TFactory = class( TTransportFactoryImpl )
+ public
+ function GetTransport( ATrans: ITransport): ITransport; override;
+ end;
+
+{$IF CompilerVersion >= 21.0}
+ class constructor Create;
+{$IFEND}
+ constructor Create; overload;
+ constructor Create( ATrans: ITransport); overload;
+ destructor Destroy; override;
+
+ procedure Open(); override;
+ function GetIsOpen: Boolean; override;
+
+ procedure Close(); override;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ procedure Flush; override;
+ end;
+
+{$IF CompilerVersion < 21.0}
+procedure TFramedTransportImpl_Initialize;
+{$IFEND}
+
+implementation
+
+{ TTransportImpl }
+
+procedure TTransportImpl.Flush;
+begin
+
+end;
+
+function TTransportImpl.Peek: Boolean;
+begin
+ Result := IsOpen;
+end;
+
+function TTransportImpl.ReadAll( var buf: TBytes; off, len: Integer): Integer;
+var
+ got : Integer;
+ ret : Integer;
+begin
+ got := 0;
+ while ( got < len) do
+ begin
+ ret := Read( buf, off + got, len - got);
+ if ( ret <= 0 ) then
+ begin
+ raise TTransportException.Create( 'Cannot read, Remote side has closed' );
+ end;
+ got := got + ret;
+ end;
+ Result := got;
+end;
+
+procedure TTransportImpl.Write( const buf: TBytes);
+begin
+ Self.Write( buf, 0, Length(buf) );
+end;
+
+{ THTTPClientImpl }
+
+procedure THTTPClientImpl.Close;
+begin
+ FInputStream := nil;
+ FOutputStream := nil;
+end;
+
+constructor THTTPClientImpl.Create(const AUri: string);
+begin
+ inherited Create;
+ FUri := AUri;
+ FCustomHeaders := TThriftDictionaryImpl<string,string>.Create;
+ FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
+end;
+
+function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;
+var
+ pair : TPair<string,string>;
+begin
+{$IF CompilerVersion >= 21.0}
+ Result := CoXMLHTTP.Create;
+{$ELSE}
+ Result := CoXMLHTTPRequest.Create;
+{$IFEND}
+
+ Result.open('POST', FUri, False, '', '');
+ Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
+ Result.setRequestHeader( 'Accept', 'application/x-thrift');
+ Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient');
+
+ for pair in FCustomHeaders do
+ begin
+ Result.setRequestHeader( pair.Key, pair.Value );
+ end;
+end;
+
+destructor THTTPClientImpl.Destroy;
+begin
+ Close;
+ inherited;
+end;
+
+procedure THTTPClientImpl.Flush;
+begin
+ try
+ SendRequest;
+ finally
+ FOutputStream := nil;
+ FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
+ end;
+end;
+
+function THTTPClientImpl.GetConnectionTimeout: Integer;
+begin
+ Result := FConnectionTimeout;
+end;
+
+function THTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;
+begin
+ Result := FCustomHeaders;
+end;
+
+function THTTPClientImpl.GetIsOpen: Boolean;
+begin
+ Result := True;
+end;
+
+function THTTPClientImpl.GetReadTimeout: Integer;
+begin
+ Result := FReadTimeout;
+end;
+
+procedure THTTPClientImpl.Open;
+begin
+
+end;
+
+function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
+begin
+ if FInputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'No request has been sent');
+ end;
+ try
+ Result := FInputStream.Read( buf, off, len )
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.Unknown,
+ E.Message);
+ end;
+ end;
+end;
+
+procedure THTTPClientImpl.SendRequest;
+var
+ xmlhttp : IXMLHTTPRequest;
+ ms : TMemoryStream;
+ a : TBytes;
+ len : Integer;
+begin
+ xmlhttp := CreateRequest;
+
+ ms := TMemoryStream.Create;
+ try
+ a := FOutputStream.ToArray;
+ len := Length(a);
+ if len > 0 then
+ begin
+ ms.WriteBuffer( Pointer(@a[0])^, len);
+ end;
+ ms.Position := 0;
+ xmlhttp.send( IUnknown( TStreamAdapter.Create( ms, soReference )));
+ FInputStream := nil;
+ FInputStream := TThriftStreamAdapterCOM.Create( IUnknown( xmlhttp.responseStream) as IStream);
+ finally
+ ms.Free;
+ end;
+end;
+
+procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
+begin
+ FConnectionTimeout := Value;
+end;
+
+procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
+begin
+ FReadTimeout := Value
+end;
+
+procedure THTTPClientImpl.Write( const buf: TBytes; off, len: Integer);
+begin
+ FOutputStream.Write( buf, off, len);
+end;
+
+{ TTransportException }
+
+constructor TTransportException.Create(AType: TExceptionType);
+begin
+ Create( AType, '' )
+end;
+
+constructor TTransportException.Create(AType: TExceptionType;
+ const msg: string);
+begin
+ inherited Create(msg);
+ FType := AType;
+end;
+
+constructor TTransportException.Create(const msg: string);
+begin
+ inherited Create(msg);
+end;
+
+{ TServerTransportImpl }
+
+function TServerTransportImpl.Accept: ITransport;
+begin
+ Result := AcceptImpl;
+ if Result = nil then
+ begin
+ raise TTransportException.Create( 'accept() may not return NULL' );
+ end;
+end;
+
+{ TTransportFactoryImpl }
+
+function TTransportFactoryImpl.GetTransport(ATrans: ITransport): ITransport;
+begin
+ Result := ATrans;
+end;
+
+{ TServerSocket }
+
+constructor TServerSocketImpl.Create(AServer: TTcpServer; AClientTimeout: Integer);
+begin
+ FServer := AServer;
+ FClientTimeout := AClientTimeout;
+end;
+
+constructor TServerSocketImpl.Create(AServer: TTcpServer);
+begin
+ Create( AServer, 0 );
+end;
+
+constructor TServerSocketImpl.Create(APort: Integer);
+begin
+ Create( APort, 0 );
+end;
+
+function TServerSocketImpl.AcceptImpl: ITransport;
+var
+ ret : TCustomIpClient;
+ ret2 : IStreamTransport;
+ ret3 : ITransport;
+begin
+ if FServer = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'No underlying server socket.');
+ end;
+
+ try
+ ret := TCustomIpClient.Create(nil);
+ if ( not FServer.Accept( ret )) then
+ begin
+ ret.Free;
+ Result := nil;
+ Exit;
+ end;
+
+ if ret = nil then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ ret2 := TSocketImpl.Create( ret );
+ if FUseBufferedSocket then
+ begin
+ ret3 := TBufferedTransportImpl.Create(ret2);
+ Result := ret3;
+ end else
+ begin
+ Result := ret2;
+ end;
+
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create( E.ToString );
+ end;
+ end;
+end;
+
+procedure TServerSocketImpl.Close;
+begin
+ if FServer <> nil then
+ begin
+ try
+ FServer.Active := False;
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create('Error on closing socket : ' + E.Message);
+ end;
+ end;
+ end;
+end;
+
+constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer;
+ AUseBufferedSockets: Boolean);
+begin
+ FPort := APort;
+ FClientTimeout := AClientTimeout;
+ FUseBufferedSocket := AUseBufferedSockets;
+ FOwnsServer := True;
+ FServer := TTcpServer.Create( nil );
+ FServer.BlockMode := bmBlocking;
+{$IF CompilerVersion >= 21.0}
+ FServer.LocalPort := AnsiString( IntToStr( FPort));
+{$ELSE}
+ FServer.LocalPort := IntToStr( FPort);
+{$IFEND}
+end;
+
+destructor TServerSocketImpl.Destroy;
+begin
+ if FOwnsServer then
+ begin
+ FServer.Free;
+ end;
+ inherited;
+end;
+
+procedure TServerSocketImpl.Listen;
+begin
+ if FServer <> nil then
+ begin
+ try
+ FServer.Active := True;
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);
+ end;
+ end;
+ end;
+end;
+
+constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer);
+begin
+ Create( APort, AClientTimeout, False );
+end;
+
+{ TSocket }
+
+constructor TSocketImpl.Create(AClient : TCustomIpClient);
+var
+ stream : IThriftStream;
+begin
+ FClient := AClient;
+ stream := TTcpSocketStreamImpl.Create( FClient);
+ FInputStream := stream;
+ FOutputStream := stream;
+end;
+
+constructor TSocketImpl.Create(const AHost: string; APort: Integer);
+begin
+ Create( AHost, APort, 0);
+end;
+
+procedure TSocketImpl.Close;
+begin
+ inherited Close;
+ if FClient <> nil then
+ begin
+ FClient.Free;
+ FClient := nil;
+ end;
+end;
+
+constructor TSocketImpl.Create(const AHost: string; APort, ATimeout: Integer);
+begin
+ FHost := AHost;
+ FPort := APort;
+ FTimeout := ATimeout;
+ InitSocket;
+end;
+
+destructor TSocketImpl.Destroy;
+begin
+ if FOwnsClient then
+ begin
+ FClient.Free;
+ end;
+ inherited;
+end;
+
+function TSocketImpl.GetIsOpen: Boolean;
+begin
+ Result := False;
+ if FClient <> nil then
+ begin
+ Result := FClient.Connected;
+ end;
+end;
+
+procedure TSocketImpl.InitSocket;
+var
+ stream : IThriftStream;
+begin
+ if FClient <> nil then
+ begin
+ if FOwnsClient then
+ begin
+ FClient.Free;
+ FClient := nil;
+ end;
+ end;
+ FClient := TTcpClient.Create( nil );
+ FOwnsClient := True;
+
+ stream := TTcpSocketStreamImpl.Create( FClient);
+ FInputStream := stream;
+ FOutputStream := stream;
+
+end;
+
+procedure TSocketImpl.Open;
+begin
+ if IsOpen then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.AlreadyOpen,
+ 'Socket already connected');
+ end;
+
+ if FHost = '' then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Cannot open null host');
+ end;
+
+ if Port <= 0 then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Cannot open without port');
+ end;
+
+ if FClient = nil then
+ begin
+ InitSocket;
+ end;
+
+ FClient.RemoteHost := TSocketHost( Host);
+ FClient.RemotePort := TSocketPort( IntToStr( Port));
+ FClient.Connect;
+
+ FInputStream := TTcpSocketStreamImpl.Create( FClient);
+ FOutputStream := FInputStream;
+end;
+
+{ TBufferedStream }
+
+procedure TBufferedStreamImpl.Close;
+begin
+ Flush;
+ FStream := nil;
+ FBuffer.Free;
+ FBuffer := nil;
+end;
+
+constructor TBufferedStreamImpl.Create(AStream: IThriftStream; ABufSize: Integer);
+begin
+ FStream := AStream;
+ FBufSize := ABufSize;
+ FBuffer := TMemoryStream.Create;
+end;
+
+destructor TBufferedStreamImpl.Destroy;
+begin
+ Close;
+ inherited;
+end;
+
+procedure TBufferedStreamImpl.Flush;
+var
+ buf : TBytes;
+ len : Integer;
+begin
+ if IsOpen then
+ begin
+ len := FBuffer.Size;
+ if len > 0 then
+ begin
+ SetLength( buf, len );
+ FBuffer.Position := 0;
+ FBuffer.Read( Pointer(@buf[0])^, len );
+ FStream.Write( buf, 0, len );
+ end;
+ FBuffer.Clear;
+ end;
+end;
+
+function TBufferedStreamImpl.IsOpen: Boolean;
+begin
+ Result := (FBuffer <> nil) and ( FStream <> nil);
+end;
+
+procedure TBufferedStreamImpl.Open;
+begin
+
+end;
+
+function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+var
+ nRead : Integer;
+ tempbuf : TBytes;
+begin
+ inherited;
+ Result := 0;
+ if count > 0 then
+ begin
+ if IsOpen then
+ begin
+ if FBuffer.Position >= FBuffer.Size then
+ begin
+ FBuffer.Clear;
+ SetLength( tempbuf, FBufSize);
+ nRead := FStream.Read( tempbuf, 0, FBufSize );
+ if nRead > 0 then
+ begin
+ FBuffer.WriteBuffer( Pointer(@tempbuf[0])^, nRead );
+ FBuffer.Position := 0;
+ end;
+ end;
+
+ if FBuffer.Position < FBuffer.Size then
+ begin
+ Result := FBuffer.Read( Pointer(@buffer[offset])^, count );
+ end;
+ end;
+ end;
+end;
+
+function TBufferedStreamImpl.ToArray: TBytes;
+var
+ len : Integer;
+begin
+ len := 0;
+
+ if IsOpen then
+ begin
+ len := FBuffer.Size;
+ end;
+
+ SetLength( Result, len);
+
+ if len > 0 then
+ begin
+ FBuffer.Position := 0;
+ FBuffer.Read( Pointer(@Result[0])^, len );
+ end;
+end;
+
+procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
+begin
+ inherited;
+ if count > 0 then
+ begin
+ if IsOpen then
+ begin
+ FBuffer.Write( Pointer(@buffer[offset])^, count );
+ if FBuffer.Size > FBufSize then
+ begin
+ Flush;
+ end;
+ end;
+ end;
+end;
+
+{ TStreamTransportImpl }
+
+procedure TStreamTransportImpl.Close;
+begin
+ if FInputStream <> FOutputStream then
+ begin
+ if FInputStream <> nil then
+ begin
+ FInputStream := nil;
+ end;
+ if FOutputStream <> nil then
+ begin
+ FOutputStream := nil;
+ end;
+ end else
+ begin
+ FInputStream := nil;
+ FOutputStream := nil;
+ end;
+end;
+
+constructor TStreamTransportImpl.Create( AInputStream : IThriftStream; AOutputStream : IThriftStream);
+begin
+ FInputStream := AInputStream;
+ FOutputStream := AOutputStream;
+end;
+
+destructor TStreamTransportImpl.Destroy;
+begin
+ FInputStream := nil;
+ FOutputStream := nil;
+ inherited;
+end;
+
+procedure TStreamTransportImpl.Flush;
+begin
+ if FOutputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot flush null outputstream' );
+ end;
+
+ FOutputStream.Flush;
+end;
+
+function TStreamTransportImpl.GetInputStream: IThriftStream;
+begin
+ Result := FInputStream;
+end;
+
+function TStreamTransportImpl.GetIsOpen: Boolean;
+begin
+ Result := True;
+end;
+
+function TStreamTransportImpl.GetOutputStream: IThriftStream;
+begin
+ Result := FInputStream;
+end;
+
+procedure TStreamTransportImpl.Open;
+begin
+
+end;
+
+function TStreamTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+begin
+ if FInputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null inputstream' );
+ end;
+ Result := FInputStream.Read( buf, off, len );
+end;
+
+procedure TStreamTransportImpl.Write(const buf: TBytes; off, len: Integer);
+begin
+ if FOutputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null outputstream' );
+ end;
+
+ FOutputStream.Write( buf, off, len );
+end;
+
+{ TBufferedTransportImpl }
+
+constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport);
+begin
+ Create( ATransport, 1024 );
+end;
+
+procedure TBufferedTransportImpl.Close;
+begin
+ FTransport.Close;
+end;
+
+constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport;
+ ABufSize: Integer);
+begin
+ FTransport := ATransport;
+ FBufSize := ABufSize;
+ InitBuffers;
+end;
+
+procedure TBufferedTransportImpl.Flush;
+begin
+ if FOutputBuffer <> nil then
+ begin
+ FOutputBuffer.Flush;
+ end;
+end;
+
+function TBufferedTransportImpl.GetIsOpen: Boolean;
+begin
+ Result := FTransport.IsOpen;
+end;
+
+function TBufferedTransportImpl.GetUnderlyingTransport: ITransport;
+begin
+ Result := FTransport;
+end;
+
+procedure TBufferedTransportImpl.InitBuffers;
+begin
+ if FTransport.InputStream <> nil then
+ begin
+ FInputBuffer := TBufferedStreamImpl.Create( FTransport.InputStream, FBufSize );
+ end;
+ if FTransport.OutputStream <> nil then
+ begin
+ FOutputBuffer := TBufferedStreamImpl.Create( FTransport.OutputStream, FBufSize );
+ end;
+end;
+
+procedure TBufferedTransportImpl.Open;
+begin
+ FTransport.Open
+end;
+
+function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+begin
+ Result := 0;
+ if FInputBuffer <> nil then
+ begin
+ Result := FInputBuffer.Read( buf, off, len );
+ end;
+end;
+
+procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);
+begin
+ if FOutputBuffer <> nil then
+ begin
+ FOutputBuffer.Write( buf, off, len );
+ end;
+end;
+
+{ TFramedTransportImpl }
+
+{$IF CompilerVersion < 21.0}
+procedure TFramedTransportImpl_Initialize;
+begin
+ SetLength( TFramedTransportImpl.FHeader_Dummy, TFramedTransportImpl.FHeaderSize);
+ FillChar( TFramedTransportImpl.FHeader_Dummy[0],
+ Length( TFramedTransportImpl.FHeader_Dummy) * SizeOf( Byte ), 0);
+end;
+{$ELSE}
+class constructor TFramedTransportImpl.Create;
+begin
+ SetLength( FHeader_Dummy, FHeaderSize);
+ FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);
+end;
+{$IFEND}
+
+constructor TFramedTransportImpl.Create;
+begin
+ InitWriteBuffer;
+end;
+
+procedure TFramedTransportImpl.Close;
+begin
+ FTransport.Close;
+end;
+
+constructor TFramedTransportImpl.Create(ATrans: ITransport);
+begin
+ InitWriteBuffer;
+ FTransport := ATrans;
+end;
+
+destructor TFramedTransportImpl.Destroy;
+begin
+ FWriteBuffer.Free;
+ FReadBuffer.Free;
+ inherited;
+end;
+
+procedure TFramedTransportImpl.Flush;
+var
+ buf : TBytes;
+ len : Integer;
+ data_len : Integer;
+
+begin
+ len := FWriteBuffer.Size;
+ SetLength( buf, len);
+ if len > 0 then
+ begin
+ System.Move( FWriteBuffer.Memory^, buf[0], len );
+ end;
+
+ data_len := len - FHeaderSize;
+ if (data_len < 0) then
+ begin
+ raise Exception.Create( 'TFramedTransport.Flush: data_len < 0' );
+ end;
+
+ InitWriteBuffer;
+
+ buf[0] := Byte($FF and (data_len shr 24));
+ buf[1] := Byte($FF and (data_len shr 16));
+ buf[2] := Byte($FF and (data_len shr 8));
+ buf[3] := Byte($FF and data_len);
+
+ FTransport.Write( buf, 0, len );
+ FTransport.Flush;
+end;
+
+function TFramedTransportImpl.GetIsOpen: Boolean;
+begin
+ Result := FTransport.IsOpen;
+end;
+
+type
+ TAccessMemoryStream = class(TMemoryStream)
+ end;
+
+procedure TFramedTransportImpl.InitWriteBuffer;
+begin
+ FWriteBuffer.Free;
+ FWriteBuffer := TMemoryStream.Create;
+ TAccessMemoryStream(FWriteBuffer).Capacity := 1024;
+ FWriteBuffer.Write( Pointer(@FHeader_Dummy[0])^, FHeaderSize);
+end;
+
+procedure TFramedTransportImpl.Open;
+begin
+ FTransport.Open;
+end;
+
+function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+var
+ got : Integer;
+begin
+ if FReadBuffer <> nil then
+ begin
+ got := FReadBuffer.Read( Pointer(@buf[0])^, len );
+ if got > 0 then
+ begin
+ Result := got;
+ Exit;
+ end;
+ end;
+
+ ReadFrame;
+ Result := FReadBuffer.Read( Pointer(@buf[0])^, len );
+end;
+
+procedure TFramedTransportImpl.ReadFrame;
+var
+ i32rd : TBytes;
+ size : Integer;
+ buff : TBytes;
+begin
+ SetLength( i32rd, FHeaderSize );
+ FTransport.ReadAll( i32rd, 0, FHeaderSize);
+ size :=
+ ((i32rd[0] and $FF) shl 24) or
+ ((i32rd[1] and $FF) shl 16) or
+ ((i32rd[2] and $FF) shl 8) or
+ (i32rd[3] and $FF);
+ SetLength( buff, size );
+ FTransport.ReadAll( buff, 0, size );
+ FReadBuffer.Free;
+ FReadBuffer := TMemoryStream.Create;
+ FReadBuffer.Write( Pointer(@buff[0])^, size );
+ FReadBuffer.Position := 0;
+end;
+
+procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer);
+begin
+ FWriteBuffer.Write( Pointer(@buf[0])^, len );
+end;
+
+{ TFramedTransport.TFactory }
+
+function TFramedTransportImpl.TFactory.GetTransport(ATrans: ITransport): ITransport;
+begin
+ Result := TFramedTransportImpl.Create( ATrans );
+end;
+
+{ TTcpSocketStreamImpl }
+
+procedure TTcpSocketStreamImpl.Close;
+begin
+ FTcpClient.Close;
+end;
+
+constructor TTcpSocketStreamImpl.Create(ATcpClient: TCustomIpClient);
+begin
+ FTcpClient := ATcpClient;
+end;
+
+procedure TTcpSocketStreamImpl.Flush;
+begin
+
+end;
+
+function TTcpSocketStreamImpl.IsOpen: Boolean;
+begin
+ Result := FTcpClient.Active;
+end;
+
+procedure TTcpSocketStreamImpl.Open;
+begin
+ FTcpClient.Open;
+end;
+
+function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset,
+ count: Integer): Integer;
+begin
+ inherited;
+ Result := FTcpClient.ReceiveBuf( Pointer(@buffer[offset])^, count);
+end;
+
+function TTcpSocketStreamImpl.ToArray: TBytes;
+var
+ len : Integer;
+begin
+ len := 0;
+ if IsOpen then
+ begin
+ len := FTcpClient.BytesReceived;
+ end;
+
+ SetLength( Result, len );
+
+ if len > 0 then
+ begin
+ FTcpClient.ReceiveBuf( Pointer(@Result[0])^, len);
+ end;
+end;
+
+procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+begin
+ inherited;
+ FTcpClient.SendBuf( Pointer(@buffer[offset])^, count);
+end;
+
+{$IF CompilerVersion < 21.0}
+initialization
+begin
+ TFramedTransportImpl_Initialize;
+end;
+{$IFEND}
+
+
+end.
Added: thrift/trunk/lib/delphi/src/Thrift.Utils.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/src/Thrift.Utils.pas?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/src/Thrift.Utils.pas (added)
+++ thrift/trunk/lib/delphi/src/Thrift.Utils.pas Tue Oct 18 14:35:26 2011
@@ -0,0 +1,36 @@
+(*
+ * 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.Utils;
+
+interface
+
+function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string;
+
+implementation
+
+function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string;
+begin
+ if B then
+ Result := TrueValue
+ else
+ Result := FalseValue;
+end;
+
+end.
Added: thrift/trunk/lib/delphi/src/Thrift.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/src/Thrift.pas?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/src/Thrift.pas (added)
+++ thrift/trunk/lib/delphi/src/Thrift.pas Tue Oct 18 14:35:26 2011
@@ -0,0 +1,156 @@
+(*
+ * 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;
+
+interface
+
+uses
+ SysUtils, Thrift.Protocol;
+
+type
+ IProcessor = interface
+ ['{B1538A07-6CAC-4406-8A4C-AFED07C70A89}']
+ function Process( iprot :IProtocol; oprot: IProtocol): Boolean;
+ end;
+
+ TApplicationException = class( SysUtils.Exception )
+ public
+ type
+{$SCOPEDENUMS ON}
+ TExceptionType = (
+ Unknown,
+ UnknownMethod,
+ InvalidMessageType,
+ WrongMethodName,
+ BadSequenceID,
+ MissingResult
+ );
+{$SCOPEDENUMS OFF}
+ private
+ FType : TExceptionType;
+ public
+ constructor Create; overload;
+ constructor Create( AType: TExceptionType); overload;
+ constructor Create( AType: TExceptionType; const msg: string); overload;
+
+ class function Read( iprot: IProtocol): TApplicationException;
+ procedure Write( oprot: IProtocol );
+ end;
+
+implementation
+
+{ TApplicationException }
+
+constructor TApplicationException.Create;
+begin
+ inherited Create( '' );
+end;
+
+constructor TApplicationException.Create(AType: TExceptionType;
+ const msg: string);
+begin
+ inherited Create( msg );
+ FType := AType;
+end;
+
+constructor TApplicationException.Create(AType: TExceptionType);
+begin
+ inherited Create('');
+ FType := AType;
+end;
+
+class function TApplicationException.Read(
+ iprot: IProtocol): TApplicationException;
+var
+ field : IField;
+ msg : string;
+ typ : TExceptionType;
+begin
+ msg := '';
+ typ := TExceptionType.Unknown;
+ while ( True ) do
+ begin
+ field := iprot.ReadFieldBegin;
+ if ( field.Type_ = TType.Stop) then
+ begin
+ Break;
+ end;
+
+ case field.Id of
+ 1 : begin
+ if ( field.Type_ = TType.String_) then
+ begin
+ msg := iprot.ReadString;
+ end else
+ begin
+ TProtocolUtil.Skip( iprot, field.Type_ );
+ end;
+ end;
+
+ 2 : begin
+ if ( field.Type_ = TType.I32) then
+ begin
+ typ := TExceptionType( iprot.ReadI32 );
+ end else
+ begin
+ TProtocolUtil.Skip( iprot, field.Type_ );
+ end;
+ end else
+ begin
+ TProtocolUtil.Skip( iprot, field.Type_);
+ end;
+ end;
+ iprot.ReadFieldEnd;
+ end;
+ iprot.ReadStructEnd;
+ Result := TApplicationException.Create( typ, msg );
+end;
+
+procedure TApplicationException.Write(oprot: IProtocol);
+var
+ struc : IStruct;
+ field : IField;
+
+begin
+ struc := TStructImpl.Create( 'TApplicationException' );
+ field := TFieldImpl.Create;
+
+ oprot.WriteStructBegin( struc );
+ if Message <> '' then
+ begin
+ field.Name := 'message';
+ field.Type_ := TType.String_;
+ field.Id := 1;
+ oprot.WriteFieldBegin( field );
+ oprot.WriteString( Message );
+ oprot.WriteFieldEnd;
+ end;
+
+ field.Name := 'type';
+ field.Type_ := TType.I32;
+ field.Id := 2;
+ oprot.WriteFieldBegin(field);
+ oprot.WriteI32(Integer(FType));
+ oprot.WriteFieldEnd();
+ oprot.WriteFieldStop();
+ oprot.WriteStructEnd();
+end;
+
+end.
Added: thrift/trunk/lib/delphi/test/TestClient.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/TestClient.pas?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/test/TestClient.pas (added)
+++ thrift/trunk/lib/delphi/test/TestClient.pas Tue Oct 18 14:35:26 2011
@@ -0,0 +1,597 @@
+(*
+ * 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 TestClient;
+
+interface
+
+uses
+ SysUtils, Classes, Thrift.Protocol, Thrift.Transport, Thrift.Test,
+ Generics.Collections, Thrift.Collections, Windows, Thrift.Console,
+ DateUtils;
+
+type
+
+ TThreadConsole = class
+ private
+ FThread : TThread;
+ public
+ procedure Write( const S : string);
+ procedure WriteLine( const S : string);
+ constructor Create( AThread: TThread);
+ end;
+
+ TClientThread = class( TThread )
+ private
+ FTransport : ITransport;
+ FNumIteration : Integer;
+ FConsole : TThreadConsole;
+
+ procedure ClientTest;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create(ATransport: ITransport; ANumIteration: Integer);
+ destructor Destroy; override;
+ end;
+
+ TTestClient = class
+ private
+ class var
+ FNumIteration : Integer;
+ FNumThread : Integer;
+ public
+ class procedure Execute( const args: array of string);
+ end;
+
+implementation
+
+{ TTestClient }
+
+class procedure TTestClient.Execute(const args: array of string);
+var
+ i : Integer;
+ host : string;
+ port : Integer;
+ url : string;
+ bBuffered : Boolean;
+ bFramed : Boolean;
+ s : string;
+ n : Integer;
+ threads : array of TThread;
+ dtStart : TDateTime;
+ test : Integer;
+ thread : TThread;
+ trans : ITransport;
+ streamtrans : IStreamTransport;
+ http : IHTTPClient;
+
+begin
+ bBuffered := False;;
+ bFramed := False;
+ try
+ host := 'localhost';
+ port := 9090;
+ url := '';
+ i := 0;
+ try
+ while ( i < Length(args) ) do
+ begin
+ try
+ if ( args[i] = '-h') then
+ begin
+ Inc( i );
+ s := args[i];
+ n := Pos( ':', s);
+ if ( n > 0 ) then
+ begin
+ host := Copy( s, 1, n - 1);
+ port := StrToInt( Copy( s, n + 1, MaxInt));
+ end else
+ begin
+ host := s;
+ end;
+ end else
+ if (args[i] = '-u') then
+ begin
+ Inc( i );
+ url := args[i];
+ end else
+ if (args[i] = '-n') then
+ begin
+ Inc( i );
+ FNumIteration := StrToInt( args[i] );
+ end else
+ if (args[i] = '-b') then
+ begin
+ bBuffered := True;
+ Console.WriteLine('Using buffered transport');
+ end else
+ if (args[i] = '-f' ) or ( args[i] = '-framed') then
+ begin
+ bFramed := True;
+ Console.WriteLine('Using framed transport');
+ end else
+ if (args[i] = '-t') then
+ begin
+ Inc( i );
+ FNumThread := StrToInt( args[i] );
+ end;
+ finally
+ Inc( i );
+ end;
+ end;
+ except
+ on E: Exception do
+ begin
+ Console.WriteLine( E.Message );
+ end;
+ end;
+
+ SetLength( threads, FNumThread);
+ dtStart := Now;
+
+ for test := 0 to FNumThread - 1 do
+ begin
+ if url = '' then
+ begin
+ streamtrans := TSocketImpl.Create( host, port );
+ trans := streamtrans;
+ if bBuffered then
+ begin
+ trans := TBufferedTransportImpl.Create( streamtrans );
+ end;
+
+ if bFramed then
+ begin
+ trans := TFramedTransportImpl.Create( trans );
+ end;
+ end else
+ begin
+ http := THTTPClientImpl.Create( url );
+ trans := http;
+ end;
+ thread := TClientThread.Create( trans, FNumIteration);
+ threads[test] := thread;
+{$WARN SYMBOL_DEPRECATED OFF}
+ thread.Resume;
+{$WARN SYMBOL_DEPRECATED ON}
+ end;
+
+ for test := 0 to FNumThread - 1 do
+ begin
+ threads[test].WaitFor;
+ end;
+
+ for test := 0 to FNumThread - 1 do
+ begin
+ threads[test].Free;
+ end;
+
+ Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
+
+ except
+ on E: Exception do
+ begin
+ Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );
+ end;
+ end;
+
+ Console.WriteLine('');
+ Console.WriteLine('done!');
+end;
+
+{ TClientThread }
+
+procedure TClientThread.ClientTest;
+var
+ binaryProtocol : TBinaryProtocolImpl;
+ client : TThriftTest.Iface;
+ s : string;
+ i8 : ShortInt;
+ i32 : Integer;
+ i64 : Int64;
+ dub : Double;
+ o : IXtruct;
+ o2 : IXtruct2;
+ i : IXtruct;
+ i2 : IXtruct2;
+ mapout : IThriftDictionary<Integer,Integer>;
+ mapin : IThriftDictionary<Integer,Integer>;
+ j : Integer;
+ first : Boolean;
+ key : Integer;
+ listout : IThriftList<Integer>;
+ listin : IThriftList<Integer>;
+ setout : IHashSet<Integer>;
+ setin : IHashSet<Integer>;
+ ret : TNumberz;
+ uid : Int64;
+ mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+ m2 : IThriftDictionary<Integer, Integer>;
+ k2 : Integer;
+ insane : IInsanity;
+ truck : IXtruct;
+ whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+ key64 : Int64;
+ val : IThriftDictionary<TNumberz, IInsanity>;
+ k2_2 : TNumberz;
+ k3 : TNumberz;
+ v2 : IInsanity;
+ userMap : IThriftDictionary<TNumberz, Int64>;
+ xtructs : IThriftList<IXtruct>;
+ x : IXtruct;
+ arg0 : ShortInt;
+ arg1 : Integer;
+ arg2 : Int64;
+ multiDict : IThriftDictionary<SmallInt, string>;
+ arg4 : TNumberz;
+ arg5 : Int64;
+ StartTick : Cardinal;
+ k : Integer;
+ proc : TThreadProcedure;
+
+begin
+ binaryProtocol := TBinaryProtocolImpl.Create( FTransport );
+ client := TThriftTest.TClient.Create( binaryProtocol );
+ try
+ if not FTransport.IsOpen then
+ begin
+ FTransport.Open;
+ end;
+ except
+ on E: Exception do
+ begin
+ Console.WriteLine( E.Message );
+ Exit;
+ end;
+ end;
+
+ Console.Write('testException()');
+ try
+ client.testException('Xception');
+ except
+ on E: TXception do
+ begin
+ Console.WriteLine( ' = ' + IntToStr(E.ErrorCode) + ', ' + E.Message_ );
+ end;
+ end;
+
+ Console.Write('testVoid()');
+ client.testVoid();
+ Console.WriteLine(' = void');
+
+ Console.Write('testString(''Test'')');
+ s := client.testString('Test');
+ Console.WriteLine(' := ''' + s + '''');
+
+ Console.Write('testByte(1)');
+ i8 := client.testByte(1);
+ Console.WriteLine(' := ' + IntToStr( i8 ));
+
+ Console.Write('testI32(-1)');
+ i32 := client.testI32(-1);
+ Console.WriteLine(' := ' + IntToStr(i32));
+
+ Console.Write('testI64(-34359738368)');
+ i64 := client.testI64(-34359738368);
+ Console.WriteLine(' := ' + IntToStr( i64));
+
+ Console.Write('testDouble(5.325098235)');
+ dub := client.testDouble(5.325098235);
+ Console.WriteLine(' := ' + FloatToStr( dub));
+
+ Console.Write('testStruct({''Zero'', 1, -3, -5})');
+ o := TXtructImpl.Create;
+ o.String_thing := 'Zero';
+ o.Byte_thing := 1;
+ o.I32_thing := -3;
+ o.I64_thing := -5;
+ i := client.testStruct(o);
+ Console.WriteLine(' := {''' +
+ i.String_thing + ''', ' +
+ IntToStr( i.Byte_thing) + ', ' +
+ IntToStr( i.I32_thing) + ', ' +
+ IntToStr( i.I64_thing) + '}');
+
+ Console.Write('testNest({1, {''Zero'', 1, -3, -5}, 5})');
+ o2 := TXtruct2Impl.Create;
+ o2.Byte_thing := 1;
+ o2.Struct_thing := o;
+ o2.I32_thing := 5;
+ i2 := client.testNest(o2);
+ i := i2.Struct_thing;
+ Console.WriteLine(' := {' + IntToStr( i2.Byte_thing) + ', {''' +
+ i.String_thing + ''', ' +
+ IntToStr( i.Byte_thing) + ', ' +
+ IntToStr( i.I32_thing) + ', ' +
+ IntToStr( i.I64_thing) + '}, ' +
+ IntToStr( i2.I32_thing) + '}');
+
+
+ mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
+
+ for j := 0 to 4 do
+ begin
+ mapout.AddOrSetValue( j, j - 10);
+ end;
+ Console.Write('testMap({');
+ first := True;
+ for key in mapout.Keys do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write( ', ' );
+ end;
+ Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
+ end;
+ Console.Write('})');
+
+ mapin := client.testMap( mapout );
+ Console.Write(' = {');
+ first := True;
+ for key in mapin.Keys do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write( ', ' );
+ end;
+ Console.Write( IntToStr( key) + ' => ' + IntToStr( mapin[key]));
+ end;
+ Console.WriteLine('}');
+
+ setout := THashSetImpl<Integer>.Create;
+ for j := -2 to 2 do
+ begin
+ setout.Add( j );
+ end;
+ Console.Write('testSet({');
+ first := True;
+ for j in setout do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write(', ');
+ end;
+ Console.Write(IntToStr( j));
+ end;
+ Console.Write('})');
+
+ Console.Write(' = {');
+
+ first := True;
+ setin := client.testSet(setout);
+ for j in setin do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write(', ');
+ end;
+ Console.Write(IntToStr( j));
+ end;
+ Console.WriteLine('}');
+
+ Console.Write('testEnum(ONE)');
+ ret := client.testEnum(TNumberz.ONE);
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));
+
+ Console.Write('testEnum(TWO)');
+ ret := client.testEnum(TNumberz.TWO);
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));
+
+ Console.Write('testEnum(THREE)');
+ ret := client.testEnum(TNumberz.THREE);
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));
+
+ Console.Write('testEnum(FIVE)');
+ ret := client.testEnum(TNumberz.FIVE);
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));
+
+ Console.Write('testEnum(EIGHT)');
+ ret := client.testEnum(TNumberz.EIGHT);
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));
+
+ Console.Write('testTypedef(309858235082523)');
+ uid := client.testTypedef(309858235082523);
+ Console.WriteLine(' = ' + IntToStr( uid));
+
+ Console.Write('testMapMap(1)');
+ mm := client.testMapMap(1);
+ Console.Write(' = {');
+ for key in mm.Keys do
+ begin
+ Console.Write( IntToStr( key) + ' => {');
+ m2 := mm[key];
+ for k2 in m2.Keys do
+ begin
+ Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
+ end;
+ Console.Write('}, ');
+ end;
+ Console.WriteLine('}');
+
+ insane := TInsanityImpl.Create;
+ insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
+ insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
+ truck := TXtructImpl.Create;
+ truck.String_thing := 'Truck';
+ truck.Byte_thing := 8;
+ truck.I32_thing := 8;
+ truck.I64_thing := 8;
+ insane.Xtructs := TThriftListImpl<IXtruct>.Create;
+ insane.Xtructs.Add( truck );
+ Console.Write('testInsanity()');
+ whoa := client.testInsanity( insane );
+ Console.Write(' = {');
+ for key64 in whoa.Keys do
+ begin
+ val := whoa[key64];
+ Console.Write( IntToStr( key64) + ' => {');
+ for k2_2 in val.Keys do
+ begin
+ v2 := val[k2_2];
+ Console.Write( IntToStr( Integer( k2_2)) + ' => {');
+ userMap := v2.UserMap;
+ Console.Write('{');
+ if userMap <> nil then
+ begin
+ for k3 in userMap.Keys do
+ begin
+ Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
+ end;
+ end else
+ begin
+ Console.Write('null');
+ end;
+ Console.Write('}, ');
+ xtructs := v2.Xtructs;
+ Console.Write('{');
+
+ if xtructs <> nil then
+ begin
+ for x in xtructs do
+ begin
+ Console.Write('{"' + x.String_thing + '", ' +
+ IntToStr( x.Byte_thing) + ', ' +
+ IntToStr( x.I32_thing) + ', ' +
+ IntToStr( x.I32_thing) + '}, ');
+ end;
+ end else
+ begin
+ Console.Write('null');
+ end;
+ Console.Write('}');
+ Console.Write('}, ');
+ end;
+ Console.Write('}, ');
+ end;
+ Console.WriteLine('}');
+
+ arg0 := 1;
+ arg1 := 2;
+ arg2 := High(Int64);
+
+ multiDict := TThriftDictionaryImpl<SmallInt, string>.Create;
+ multiDict.AddOrSetValue( 1, 'one');
+
+ arg4 := TNumberz.FIVE;
+ arg5 := 5000000;
+ Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
+ IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
+ multiDict.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
+ IntToStr( arg5) + ')');
+
+ Console.WriteLine('Test Oneway(1)');
+ client.testOneway(1);
+
+ Console.Write('Test Calltime()');
+ StartTick := GetTIckCount;
+
+ for k := 0 to 1000 - 1 do
+ begin
+ client.testVoid();
+ end;
+ Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
+
+end;
+
+constructor TClientThread.Create(ATransport: ITransport; ANumIteration: Integer);
+begin
+ inherited Create( True );
+ FNumIteration := ANumIteration;
+ FTransport := ATransport;
+ FConsole := TThreadConsole.Create( Self );
+end;
+
+destructor TClientThread.Destroy;
+begin
+ FConsole.Free;
+ inherited;
+end;
+
+procedure TClientThread.Execute;
+var
+ i : Integer;
+ proc : TThreadProcedure;
+begin
+ for i := 0 to FNumIteration - 1 do
+ begin
+ ClientTest;
+ end;
+
+ proc := procedure
+ begin
+ if FTransport <> nil then
+ begin
+ FTransport.Close;
+ FTransport := nil;
+ end;
+ end;
+
+ Synchronize( proc );
+end;
+
+{ TThreadConsole }
+
+constructor TThreadConsole.Create(AThread: TThread);
+begin
+ FThread := AThread;
+end;
+
+procedure TThreadConsole.Write(const S: string);
+var
+ proc : TThreadProcedure;
+begin
+ proc := procedure
+ begin
+ Console.Write( S );
+ end;
+ TThread.Synchronize( FThread, proc);
+end;
+
+procedure TThreadConsole.WriteLine(const S: string);
+var
+ proc : TThreadProcedure;
+begin
+ proc := procedure
+ begin
+ Console.WriteLine( S );
+ end;
+ TThread.Synchronize( FThread, proc);
+end;
+
+initialization
+begin
+ TTestClient.FNumIteration := 1;
+ TTestClient.FNumThread := 1;
+end;
+
+end.
Added: thrift/trunk/lib/delphi/test/TestServer.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/TestServer.pas?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/test/TestServer.pas (added)
+++ thrift/trunk/lib/delphi/test/TestServer.pas Tue Oct 18 14:35:26 2011
@@ -0,0 +1,460 @@
+(*
+ * 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 TestServer;
+
+interface
+
+uses
+ SysUtils,
+ Generics.Collections,
+ Thrift.Console,
+ Thrift.Server,
+ Thrift.Transport,
+ Thrift.Collections,
+ Thrift.Utils,
+ Thrift.Test,
+ Thrift,
+ Contnrs;
+
+type
+ TTestServer = class
+ public
+ type
+
+ ITestHandler = interface( TThriftTest.Iface )
+ procedure SetServer( AServer : IServer );
+ end;
+
+ TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
+ private
+ FServer : IServer;
+ protected
+ procedure testVoid();
+ function testString(thing: string): string;
+ function testByte(thing: ShortInt): ShortInt;
+ function testI32(thing: Integer): Integer;
+ function testI64(thing: Int64): Int64;
+ function testDouble(thing: Double): Double;
+ function testStruct(thing: IXtruct): IXtruct;
+ function testNest(thing: IXtruct2): IXtruct2;
+ function testMap(thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
+ function testStringMap(thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
+ function testSet(thing: IHashSet<Integer>): IHashSet<Integer>;
+ function testList(thing: IThriftList<Integer>): IThriftList<Integer>;
+ function testEnum(thing: TNumberz): TNumberz;
+ function testTypedef(thing: Int64): Int64;
+ function testMapMap(hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+ function testInsanity(argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+ function testMulti(arg0: ShortInt; arg1: Integer; arg2: Int64; arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz; arg5: Int64): IXtruct;
+ procedure testException(arg: string);
+ function testMultiException(arg0: string; arg1: string): IXtruct;
+ procedure testOneway(secondsToSleep: Integer);
+
+ procedure testStop;
+
+ procedure SetServer( AServer : IServer );
+ end;
+
+ class procedure Execute( args: array of string);
+ end;
+
+implementation
+
+{ TTestServer.TTestHandlerImpl }
+
+procedure TTestServer.TTestHandlerImpl.SetServer(AServer: IServer);
+begin
+ FServer := AServer;
+end;
+
+function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;
+begin
+ Console.WriteLine('testByte("' + IntToStr( thing) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testDouble(thing: Double): Double;
+begin
+ Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;
+begin
+ Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testException(arg: string);
+var
+ x : TXception;
+begin
+ Console.WriteLine('testException(' + arg + ')');
+ if ( arg = 'Xception') then
+ begin
+ x := TXception.Create;
+ x.ErrorCode := 1001;
+ x.Message_ := 'This is an Xception';
+ raise x;
+ end;
+end;
+
+function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;
+begin
+ Console.WriteLine('testI32("' + IntToStr( thing) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testI64(thing: Int64): Int64;
+begin
+ Console.WriteLine('testI64("' + IntToStr( thing) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testInsanity(
+ argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+var
+ hello, goodbye : IXtruct;
+ crazy : IInsanity;
+ looney : IInsanity;
+ first_map : IThriftDictionary<TNumberz, IInsanity>;
+ second_map : IThriftDictionary<TNumberz, IInsanity>;
+ insane : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+
+begin
+
+ Console.WriteLine('testInsanity()');
+ hello := TXtructImpl.Create;
+ hello.String_thing := 'hello';
+ hello.Byte_thing := 2;
+ hello.I32_thing := 2;
+ hello.I64_thing := 2;
+
+ goodbye := TXtructImpl.Create;
+ goodbye.String_thing := 'Goodbye4';
+ goodbye.Byte_thing := 4;
+ goodbye.I32_thing := 4;
+ goodbye.I64_thing := 4;
+
+ crazy := TInsanityImpl.Create;
+ crazy.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
+ crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8);
+ crazy.Xtructs := TThriftListImpl<IXtruct>.Create;
+ crazy.Xtructs.Add(goodbye);
+
+ looney := TInsanityImpl.Create;
+ crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5);
+ crazy.Xtructs.Add(hello);
+
+ first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
+ second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
+
+ first_map.AddOrSetValue( TNumberz.SIX, crazy);
+ first_map.AddOrSetValue( TNumberz.THREE, crazy);
+
+ second_map.AddOrSetValue( TNumberz.SIX, looney);
+
+ insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;
+
+ insane.AddOrSetValue( 1, first_map);
+ insane.AddOrSetValue( 2, second_map);
+
+ Result := insane;
+end;
+
+function TTestServer.TTestHandlerImpl.testList(
+ thing: IThriftList<Integer>): IThriftList<Integer>;
+var
+ first : Boolean;
+ elem : Integer;
+begin
+ Console.Write('testList({');
+ first := True;
+ for elem in thing do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write(', ');
+ end;
+ Console.Write( IntToStr( elem));
+ end;
+ Console.WriteLine('})');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testMap(
+ thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
+var
+ first : Boolean;
+ key : Integer;
+begin
+ Console.Write('testMap({');
+ first := True;
+ for key in thing.Keys do
+ begin
+ if (first) then
+ begin
+ first := false;
+ end else
+ begin
+ Console.Write(', ');
+ end;
+ Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key]));
+ end;
+ Console.WriteLine('})');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.TestMapMap(
+ hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+var
+ mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+ pos : IThriftDictionary<Integer, Integer>;
+ neg : IThriftDictionary<Integer, Integer>;
+ i : Integer;
+begin
+ Console.WriteLine('testMapMap(' + IntToStr( hello) + ')');
+ mapmap := TThriftDictionaryImpl<Integer, IThriftDictionary<Integer, Integer>>.Create;
+ pos := TThriftDictionaryImpl<Integer, Integer>.Create;
+ neg := TThriftDictionaryImpl<Integer, Integer>.Create;
+
+ for i := 1 to 4 do
+ begin
+ pos.AddOrSetValue( i, i);
+ neg.AddOrSetValue( -i, -i);
+ end;
+
+ mapmap.AddOrSetValue(4, pos);
+ mapmap.AddOrSetValue( -4, neg);
+
+ Result := mapmap;
+end;
+
+function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;
+ arg2: Int64; arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz;
+ arg5: Int64): IXtruct;
+var
+ hello : IXtruct;
+begin
+ Console.WriteLine('testMulti()');
+ hello := TXtructImpl.Create;
+ hello.String_thing := 'Hello2';
+ hello.Byte_thing := arg0;
+ hello.I32_thing := arg1;
+ hello.I64_thing := arg2;
+ Result := hello;
+end;
+
+function TTestServer.TTestHandlerImpl.testMultiException(arg0,
+ arg1: string): IXtruct;
+var
+ x : TXception;
+ x2 : TXception2;
+begin
+ Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')');
+ if ( arg0 = 'Xception') then
+ begin
+ x := TXception.Create;
+ x.ErrorCode := 1001;
+ x.Message := 'This is an Xception';
+ raise x;
+ end else
+ if ( arg0 = 'Xception2') then
+ begin
+ x2 := TXception2.Create;
+ x2.ErrorCode := 2002;
+ x2.Struct_thing := TXtructImpl.Create;
+ x2.Struct_thing.String_thing := 'This is an Xception2';
+ raise x2;
+ end;
+
+ Result := TXtructImpl.Create;
+ Result.String_thing := arg1;
+end;
+
+function TTestServer.TTestHandlerImpl.testNest(thing: IXtruct2): IXtruct2;
+var
+ temp : IXtruct;
+begin
+ temp := thing.Struct_thing;
+ Console.WriteLine('testNest({' +
+ IntToStr( thing.Byte_thing) + ', {' +
+ '"' + temp.String_thing + '", ' +
+ IntToStr( temp.Byte_thing) + ', ' +
+ IntToStr( temp.I32_thing) + ', ' +
+ IntToStr( temp.I64_thing) + '}, ' +
+ IntToStr( temp.I32_thing) + '})');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);
+begin
+ Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');
+ Sleep(secondsToSleep * 1000);
+ Console.WriteLine('testOneway finished');
+end;
+
+function TTestServer.TTestHandlerImpl.testSet(
+ thing: IHashSet<Integer>):IHashSet<Integer>;
+var
+ first : Boolean;
+ elem : Integer;
+begin
+ Console.Write('testSet({');
+ first := True;
+
+ for elem in thing do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write( ', ');
+ end;
+ Console.Write( IntToStr( elem));
+ end;
+ Console.WriteLine('})');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testStop;
+begin
+ if FServer <> nil then
+ begin
+ FServer.Stop;
+ end;
+end;
+
+function TTestServer.TTestHandlerImpl.testString(thing: string): string;
+begin
+ Console.WriteLine('teststring("' + thing + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testStringMap(
+ thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
+begin
+
+end;
+
+function TTestServer.TTestHandlerImpl.testTypedef(thing: Int64): Int64;
+begin
+ Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.TestVoid;
+begin
+ Console.WriteLine('testVoid()');
+end;
+
+function TTestServer.TTestHandlerImpl.testStruct(thing: IXtruct): IXtruct;
+begin
+ Console.WriteLine('testStruct({' +
+ '"' + thing.String_thing + '", ' +
+ IntToStr( thing.Byte_thing) + ', ' +
+ IntToStr( thing.I32_thing) + ', ' +
+ IntToStr( thing.I64_thing));
+ Result := thing;
+end;
+
+{ TTestServer }
+
+class procedure TTestServer.Execute(args: array of string);
+var
+ UseBufferedSockets : Boolean;
+ UseFramed : Boolean;
+ Port : Integer;
+ testHandler : ITestHandler;
+ testProcessor : IProcessor;
+ ServerSocket : IServerTransport;
+ ServerEngine : IServer;
+ TransportFactroy : ITransportFactory;
+
+
+begin
+ try
+ UseBufferedSockets := False;
+ UseFramed := False;
+ Port := 9090;
+
+ if ( Length( args) > 0) then
+ begin
+ Port := StrToIntDef( args[0], Port);
+
+ if ( Length( args) > 0) then
+ begin
+ if ( args[0] = 'raw' ) then
+ begin
+ // as default
+ end else
+ if ( args[0] = 'buffered' ) then
+ begin
+ UseBufferedSockets := True;
+ end else
+ if ( args[0] = 'framed' ) then
+ begin
+ UseFramed := True;
+ end else
+ begin
+ // Fall back to the older boolean syntax
+ UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets);
+ end
+ end
+ end;
+
+ testHandler := TTestHandlerImpl.Create;
+
+ testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
+ ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets );
+ if UseFramed then
+ begin
+ TransportFactroy := TFramedTransportImpl.TFactory.Create;
+ ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket,
+ TransportFactroy);
+ end else
+ begin
+ ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket);
+ end;
+
+ testHandler.SetServer( ServerEngine);
+
+ Console.WriteLine('Starting the server on port ' + IntToStr( Port) +
+ IfValue(UseBufferedSockets, ' with buffered socket', '') +
+ IfValue(useFramed, ' with framed transport', '') +
+ '...');
+
+ serverEngine.Serve;
+ testHandler.SetServer( nil);
+
+ except
+ on E: Exception do
+ begin
+ Console.Write( E.Message);
+ end;
+ end;
+ Console.WriteLine( 'done.');
+end;
+
+end.
Added: thrift/trunk/lib/delphi/test/client.dpr
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/client.dpr?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/test/client.dpr (added)
+++ thrift/trunk/lib/delphi/test/client.dpr Tue Oct 18 14:35:26 2011
@@ -0,0 +1,61 @@
+(*
+ * 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.
+ *)
+
+
+program client;
+
+{$APPTYPE CONSOLE}
+
+uses
+ SysUtils,
+ TestClient in 'TestClient.pas',
+ Thrift.Test in 'gen-delphi\Thrift.Test.pas',
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas',
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas';
+
+var
+ nParamCount : Integer;
+ args : array of string;
+ i : Integer;
+ arg : string;
+ s : string;
+
+begin
+ try
+ nParamCount := ParamCount;
+ SetLength( args, nParamCount);
+ for i := 1 to nParamCount do
+ begin
+ arg := ParamStr( i );
+ args[i-1] := arg;
+ end;
+ TTestClient.Execute( args );
+ Readln;
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
+
Added: thrift/trunk/lib/delphi/test/maketest.sh
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/maketest.sh?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/test/maketest.sh (added)
+++ thrift/trunk/lib/delphi/test/maketest.sh Tue Oct 18 14:35:26 2011
@@ -0,0 +1,23 @@
+#!/bin/sh
+
+#
+# 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.
+#
+
+../../../compiler/cpp/thrift --gen delphi -o . ../../../test/ThriftTest.thrift
+
Added: thrift/trunk/lib/delphi/test/server.dpr
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/server.dpr?rev=1185688&view=auto
==============================================================================
--- thrift/trunk/lib/delphi/test/server.dpr (added)
+++ thrift/trunk/lib/delphi/test/server.dpr Tue Oct 18 14:35:26 2011
@@ -0,0 +1,62 @@
+(*
+ * 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.
+ *)
+
+program server;
+
+{$APPTYPE CONSOLE}
+
+uses
+ SysUtils,
+ TestServer in 'TestServer.pas',
+ Thrift.Test in 'gen-delphi\Thrift.Test.pas',
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';
+
+var
+ nParamCount : Integer;
+ args : array of string;
+ i : Integer;
+ arg : string;
+ s : string;
+
+begin
+ try
+ nParamCount := ParamCount;
+ SetLength( args, nParamCount);
+ for i := 1 to nParamCount do
+ begin
+ arg := ParamStr( i );
+ args[i-1] := arg;
+ end;
+ TTestServer.Execute( args );
+ Readln;
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
+
+
+
Modified: thrift/trunk/test/ThriftTest.thrift
URL: http://svn.apache.org/viewvc/thrift/trunk/test/ThriftTest.thrift?rev=1185688&r1=1185687&r2=1185688&view=diff
==============================================================================
--- thrift/trunk/test/ThriftTest.thrift (original)
+++ thrift/trunk/test/ThriftTest.thrift Tue Oct 18 14:35:26 2011
@@ -33,6 +33,7 @@ namespace py ThriftTest
namespace py.twisted ThriftTest
namespace go ThriftTest
namespace php ThriftTest
+namespace delphi Thrift.Test
namespace * thrift.test
/**